home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / gnu_st.lha / gnu_st / smalltalk-1.1.1 / st-changelog.el < prev    next >
Lisp/Scheme  |  1991-09-12  |  6KB  |  187 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;;
  4. ;;; Change log support routines for Smalltalk.
  5. ;;;
  6. ;;; Steve Byrne, February 1989.
  7. ;;;
  8. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  9. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10.  
  11. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  12. ;;;
  13. ;;; Copyright (C) 1990, 1991 Free Software Foundation, Inc.
  14. ;;; Written by Steve Byrne.
  15. ;;; 
  16. ;;; This file is part of GNU Smalltalk.
  17. ;;;  
  18. ;;; GNU Smalltalk is free software; you can redistribute it and/or modify it
  19. ;;; under the terms of the GNU General Public License as published by the Free
  20. ;;; Software Foundation; either version 1, or (at your option) any later 
  21. ;;; version.
  22. ;;;
  23. ;;; GNU Smalltalk is distributed in the hope that it will be useful, but
  24. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  25. ;;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  26. ;;; for more details.
  27. ;;;
  28. ;;; You should have received a copy of the GNU General Public License along
  29. ;;; with GNU Smalltalk; see the file COPYING.  If not, write to the Free
  30. ;;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  31. ;;;
  32. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  33.  
  34. (defconst smalltalk-date-column 13)
  35. (defconst smalltalk-change-column 26)
  36.  
  37. (defun smalltalk-create-change-log (&optional position-ok)
  38.   "Inserts a changelog template into the current buffer.
  39. Only Smalltalk style changelogs are supported right now."
  40.   (interactive)
  41.   (if (not position-ok)
  42.       (progn
  43.     (message "Move the cursor to where the change log should be")
  44.     (let ((old-cc (key-binding "\C-c\C-c")))
  45.       (unwind-protect
  46.           (progn 
  47.         (local-set-key "\C-c\C-c" 'exit-recursive-edit)
  48.         (recursive-edit))
  49.         (local-set-key "\C-c\C-c" old-cc)))
  50.     (beginning-of-line)
  51.     ))
  52.   (insert-string
  53. "\"
  54. |     Change Log
  55. | ============================================================================
  56. | Author       Date       Change 
  57. \"
  58. ")
  59.   )
  60.  
  61. (defun smalltalk-add-change-log-entry ()
  62.   "Allows the user to add a change log entry to the current
  63. buffer.  If there is no change log currently present, the user is informed 
  64. of this fact, and is allowed to position the cursor where the change log
  65. should be placed."
  66.   (interactive)
  67.   (save-excursion
  68.     (while (not (smalltalk-find-change-log))
  69.       (message "Change log not found") (sit-for 5)
  70.       (smalltalk-create-change-log)
  71.     )
  72.     (smalltalk-add-change-log-mode)
  73.     ))
  74.  
  75.  
  76.  
  77. (defun smalltalk-install-change-log-functions ()
  78.   "Adds the change log functions to the current set of character bindings."
  79.   (define-key smalltalk-mode-map "\C-c\C-c" 'smalltalk-add-change-log-entry)
  80.   (define-key smalltalk-mode-map "\C-cC" 'smalltalk-create-change-log)
  81.   )
  82.  
  83. (defun smalltalk-find-change-log ()
  84.   "Locates the buffer's change log and positions the cursor where the next
  85. entry should appear.  Returns non-nil if the changelog is found, and nil if
  86. it isn't found."
  87.   (beginning-of-buffer)
  88.   (if (re-search-forward "^\|     Change Log" nil t)
  89.       (progn
  90.     (forward-line 3)
  91.     t))
  92.   )
  93.  
  94. (defun smalltalk-add-change-log-mode ()
  95.   "Go into add change log mode."
  96.   (let ((old-return (key-binding "\r"))
  97.     (old-^c^c (key-binding "\C-c\C-c"))
  98.     (mode-name mode-name)
  99.     (indent-line-function 'smalltalk-changelog-mode-indent)
  100.     (fill-prefix nil)
  101.     (fill-column 79)
  102.     (auto-fill-hook 'do-auto-fill))
  103.     (unwind-protect
  104.     (progn 
  105.       (local-set-key "\r" 'newline-and-indent)
  106.       (local-set-key "\C-c\C-c" 'exit-recursive-edit)
  107.       (setq mode-name "Changelog")
  108.       (smalltalk-init-change-log-entry)
  109.       (save-excursion
  110.         (recursive-edit))
  111.       (smalltalk-clean-up-after-changing)
  112.       )
  113.       (local-set-key "\r" old-return)
  114.       (local-set-key "\C-c\C-c" old-^c^c)
  115.       )
  116.     ))
  117.  
  118. (defun smalltalk-init-change-log-entry ()
  119.   "Inserts the initial change log entry stuff, which
  120. is the user name and the date."
  121.   (insert-string "| " (user-login-name))
  122.   (indent-to smalltalk-date-column)
  123.   (insert-string (string-date))
  124.   (indent-to smalltalk-change-column)
  125.   (save-excursion
  126.     (insert-string "\n|\n")
  127.     )
  128.   )
  129.  
  130.  
  131. (defun string-date ()
  132.   "Returns a string date of the form dd mmm yy for the
  133. current date."
  134.   (let ((now (current-time-string)))
  135.     (concat
  136.      (substring now 8 10)            ;the day
  137.      " "
  138.      (substring now 4 7)            ;the month
  139.      " "
  140.      (substring now 22 24)        ;the year
  141.      )))
  142.  
  143. (defun smalltalk-changelog-mode-indent ()
  144.   "Insert the comment continuation character, and tab to the change log
  145. text column."
  146.   (interactive)
  147.   (insert-string "|")
  148.   (indent-to change-column))
  149.  
  150. ;;; Yuck... I don't like the way I wrote this...I'll bet there is
  151. ;;; a cleaner way...
  152.  
  153. (defun smalltalk-clean-up-after-changing ()
  154.   "Performs cleanup operations such as deleting extraneous blank lines
  155. at the end of a change log entry.  Point is at the start of the text
  156. for the current change log entry."
  157.   (let (dot (num-blanks 0))
  158.     (while (not (smalltalk-line-is-blank))
  159.       (forward-line))
  160.     (setq dot (point))
  161.     (beginning-of-line)
  162.     (if (< (point) dot)            ;our first blank line is the
  163.                     ;change log line, so fake
  164.                     ;an extra line to be removed
  165.     (setq num-blanks 1))
  166.     (setq dot (point))
  167.     (while (smalltalk-line-is-blank t)
  168.       (setq num-blanks (1+ num-blanks))
  169.       (forward-line))
  170.     (if (> num-blanks 1)
  171.     (progn
  172.       (goto-char dot)
  173.       (kill-line (1- num-blanks))))
  174.     ))
  175.  
  176. (defun smalltalk-line-is-blank (&optional last-isnt-blank)
  177.   "Returns t if the line consists of the comment char followed
  178. by a /, or nothing in the columns past change-column"
  179.   (save-excursion
  180.     (beginning-of-line)
  181.     (cond ((looking-at "\"") (not last-isnt-blank))
  182.       ((looking-at " \|[ \t]*$") t)
  183.       (t (end-of-line)
  184.          (<= (current-column) change-column)))
  185.     )
  186.   )
  187.